VERSION 5.00
Begin VB.UserControl LightEdit 
   Appearance      =   0  'Flat
   BackColor       =   &H80000005&
   ClientHeight    =   630
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   2295
   ClipBehavior    =   0  'None
   HasDC           =   0   'False
   HitBehavior     =   0  'None
   KeyPreview      =   -1  'True
   MousePointer    =   3  'I-Beam
   ScaleHeight     =   42
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   153
   ToolboxBitmap   =   "LightEdit.ctx":0000
   Windowless      =   -1  'True
End
Attribute VB_Name = "LightEdit"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = True
'***************************************************************
' (c) Copyright 2000 Matthew J. Curland
'
' This file is from the CD-ROM accompanying the book:
' Advanced Visual Basic 6: Power Techniques for Everyday Programs
'   Author: Matthew Curland
'   Published by: Addison-Wesley, July 2000
'   ISBN: 0-201-70712-8
'   http://www.PowerVB.com
'***************************************************************
Option Explicit
Implements OleTypes.IHookAccelerator
Implements OleTypes.IHookWindowlessMessage
Private m_IPAOHook As IPAOHook
Private m_WLSC As WindowlessSubclass
Private m_Hook As UnknownHook
Private Type HookData
    AggData(0) As AggregateData
    IIDs(0) As IID
End Type

Public Enum LightEditBackStyle
    Transparent
    Opaque
End Enum
Public Enum LightEditClipBehavior
    [Clip None]
    [Clip Use Region]
End Enum
Public Enum LightEditHitBehavior
    [Hit None]
    [Hit Use Region]
    [Hit Use Paint]
End Enum

Private Const vbNullString As String = "" 'Override vbNullString in this module to stop API blowups
Private m_fShowCaret As Boolean
Private m_fHaveFocus As Boolean
Private m_Text As String
Private m_SelStart As Integer
Private m_SelLen As Integer
Private m_LeftChar As Integer
Private m_fHaveMouse As Boolean   'Do we current have control of the mouse?
Private m_fSkipPaint As Boolean   'Don't do the paint event
Private m_CachedRect As RECT      'Cache for window rectangle when we own the mouse.
Private m_CachedSite As IOleInPlaceSiteWindowless

'Event Declarations:
Event KeyUp(KeyCode As Integer, Shift As Integer) 'MappingInfo=UserControl,UserControl,-1,KeyUp
Attribute KeyUp.VB_Description = "Occurs when the user releases a key while an object has the focus."
Event KeyPress(KeyAscii As Integer) 'MappingInfo=UserControl,UserControl,-1,KeyPress
Attribute KeyPress.VB_Description = "Occurs when the user presses and releases an ANSI key."
Event KeyDown(KeyCode As Integer, Shift As Integer) 'MappingInfo=UserControl,UserControl,-1,KeyDown
Attribute KeyDown.VB_Description = "Occurs when the user presses a key while an object has the focus."
Event MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseUp
Attribute MouseUp.VB_Description = "Occurs when the user releases the mouse button while an object has the focus."
Event MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseMove
Attribute MouseMove.VB_Description = "Occurs when the user moves the mouse."
Event MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) 'MappingInfo=UserControl,UserControl,-1,MouseDown
Attribute MouseDown.VB_Description = "Occurs when the user presses the mouse button while an object has the focus."
Event Click() 'MappingInfo=UserControl,UserControl,-1,Click
Attribute Click.VB_Description = "Occurs when the user presses and then releases a mouse button over an object."
Event Resize() 'MappingInfo=UserControl,UserControl,-1,Resize
Attribute Resize.VB_Description = "Occurs when a form is first displayed or the size of an object changes."
Event HitTest(X As Single, Y As Single, HitResult As VBRUN.HitResultConstants) 'MappingInfo=UserControl,UserControl,-1,HitTest
Event Change()

Private Sub IHookAccelerator_TranslateAccelerator(lpmsg As OleTypes.MSG, hrReturnCode As Long)
Dim plResult As LRESULT
Dim pIPOWL As IOleInPlaceObjectWindowless
    'Return code defaults to S_FALSE (1)
    With lpmsg
        If .message = WM_KEYDOWN Then
            Select Case .wParam And &HFFFF& 'LOWORD of wparam
                Case vbKeyUp, vbKeyDown, vbKeyLeft, vbKeyRight, vbKeyHome, vbKeyEnd
                    Set pIPOWL = Me
                    hrReturnCode = pIPOWL.OnWindowMessage(.message, .wParam, .lParam, plResult)
            End Select
        End If
    End With
End Sub

Private Sub IHookWindowlessMessage_OnWindowMessage(ByVal fBefore As Boolean, ByVal uMsg As VBoostTypes.UINT, ByVal wParam As VBoostTypes.wParam, ByVal lParam As VBoostTypes.lParam, plResult As OleTypes.LRESULT, hrReturnCode As Long)
    Select Case uMsg
        Case WM_SETFOCUS
            m_fHaveFocus = True
            DisplayCaret
            OverrideActiveObject m_IPAOHook, Me
        Case WM_KILLFOCUS
            LoseCaret
            m_fHaveFocus = False
    End Select
End Sub

Private Sub UserControl_DblClick()
Dim pSite As IOleInPlaceSiteWindowless
Dim PosRect As RECT
    If m_SelStart = 0 And m_SelLen = Len(m_Text) Then Exit Sub
    m_SelStart = 0
    m_SelLen = Len(m_Text)
    Set pSite = WindowLessSite
    UpdateCaretPos pSite, CtlRect(pSite), True
End Sub

Private Sub UserControl_Initialize()
    m_Text = vbNullString
    If VBoost Is Nothing Then InitVBoost
End Sub

Private Sub UserControl_KeyDown(KeyCode As Integer, Shift As Integer)
    RaiseEvent KeyDown(KeyCode, Shift)
    Select Case KeyCode
        Case vbKeyDelete
            If Shift = vbShiftMask Then
                If m_SelLen Then
                    'Cut
                    If DoCopy Then DeleteText False
                End If
            Else
                DeleteText False
            End If
        Case vbKeyUp, vbKeyRight
            MoveCursor 1, False, Shift And vbShiftMask
        Case vbKeyDown, vbKeyLeft
            MoveCursor -1, False, Shift And vbShiftMask
        Case vbKeyHome
            MoveCursor 0, True, Shift And vbShiftMask
        Case vbKeyEnd
            MoveCursor Len(m_Text), True, Shift And vbShiftMask
        Case vbKeyInsert
            If Shift = vbCtrlMask Then
                'Copy
                DoCopy
            ElseIf Shift = vbShiftMask Then
                'Paste
                On Error Resume Next
                InsertText Clipboard.GetText
                On Error GoTo 0
            End If
        Case vbKeyX
            If Shift = vbCtrlMask And CBool(m_SelLen) Then
                'Cut
                If DoCopy Then DeleteText False
            End If
        Case vbKeyC
            If Shift = vbCtrlMask Then
                'Copy
                DoCopy
            End If
        Case vbKeyV
            If Shift = vbCtrlMask Then
                'Paste
                On Error Resume Next
                InsertText Clipboard.GetText
                On Error GoTo 0
            End If
    End Select
End Sub

Private Sub UserControl_KeyPress(KeyAscii As Integer)
    RaiseEvent KeyPress(KeyAscii)
    Select Case KeyAscii
        Case vbKeyBack
            DeleteText True
        Case Else
            If KeyAscii >= vbKeySpace Then InsertText Chr$(KeyAscii)
    End Select
End Sub
Private Sub MoveCursor(ByVal Distance As Integer, ByVal fAbsolute As Boolean, ByVal fExtendSelection As Boolean)
Dim SelStart As Long
Dim SelLen As Long
Dim TextLen As Long
Dim NewSelStart As Long
Dim NewSelLen As Long
Dim NewPos As Long
Dim CursorPos As Long
Dim pSite As IOleInPlaceSiteWindowless
Dim fNoUpdate As Boolean
Dim fForceRepaint As Boolean
    TextLen = Len(m_Text)
    If TextLen = 0 Then Exit Sub
    If fAbsolute Then
        If fExtendSelection Then
            NewSelStart = m_SelStart
            NewSelLen = Distance - m_SelStart
        Else
            NewSelStart = Distance
            NewSelLen = 0
        End If
    Else
        CursorPos = m_SelStart + m_SelLen + Distance
        If fExtendSelection Then
            If CursorPos < 0 Or CursorPos > TextLen Then Exit Sub
            NewSelStart = m_SelStart
            NewSelLen = m_SelLen + Distance
        Else
            If CursorPos < 0 Or CursorPos > TextLen Then
                NewSelStart = m_SelStart + m_SelLen
            Else
                NewSelStart = CursorPos
            End If
            NewSelLen = 0
        End If
    End If
    If NewSelStart <> m_SelStart Or NewSelLen <> m_SelLen Then
        fForceRepaint = m_SelLen <> NewSelLen
        m_SelStart = NewSelStart
        m_SelLen = NewSelLen
        Set pSite = WindowLessSite
        UpdateCaretPos pSite, CtlRect(pSite), fForceRepaint
    End If
End Sub
Private Sub DeleteText(ByVal fKillPrev As Boolean)
Dim SelStart As Long
Dim SelLen As Long
Dim TextLen As Long
Dim pSite As IOleInPlaceSiteWindowless
Dim fNoUpdate As Boolean
    TextLen = Len(m_Text)
    If TextLen Then
        'Normalize selection values
        NormalizeSelection SelStart, SelLen
        
        If SelLen Then
            'Just delete the selection, regardless of whether
            'we're killing the previous or next character.
            If SelStart Then
                'There is text before the selection
                If SelStart + SelLen = TextLen Then
                    m_Text = Left$(m_Text, SelStart)
                Else
                    m_Text = Left$(m_Text, SelStart) & Right$(m_Text, TextLen - SelStart - SelLen)
                End If
            ElseIf SelLen = TextLen Then
                'The whole item is selected
                m_Text = vbNullString
            Else
                'Text after selection only
                m_Text = Right$(m_Text, TextLen - SelStart - SelLen)
            End If
            m_SelStart = SelStart
        Else
            If fKillPrev Then
                If SelStart Then
                    If SelStart = 1 Then
                        m_Text = Mid$(m_Text, 2)
                    Else
                        m_Text = Left$(m_Text, SelStart - 1) & Right$(m_Text, TextLen - SelStart)
                    End If
                    m_SelStart = SelStart - 1
                Else
                    fNoUpdate = True
                End If
            Else
                If SelStart < TextLen Then
                    If SelStart = TextLen - 1 Then
                        m_Text = Left$(m_Text, SelStart)
                    Else
                        m_Text = Left$(m_Text, SelStart) & Right$(m_Text, TextLen - SelStart - 1)
                    End If
                Else
                    fNoUpdate = True
                End If
            End If
        End If
        m_SelLen = 0
        If Not fNoUpdate Then
            Set pSite = WindowLessSite
            UpdateCaretPos pSite, CtlRect(pSite), True
            RaiseEvent Change
        End If
    End If
End Sub
Private Sub InsertText(NewText As String)
Dim SelStart As Long
Dim SelLen As Long
Dim TextLen As Long
Dim pSite As IOleInPlaceSiteWindowless
    TextLen = Len(m_Text)
    LoseCaret
    If TextLen Then
        NormalizeSelection SelStart, SelLen
        If SelStart Then
            If SelLen Then
                If SelStart + SelLen = TextLen Then
                    m_Text = Left$(m_Text, SelStart) & NewText
                Else
                    m_Text = Left$(m_Text, SelStart) & NewText & Right$(m_Text, TextLen - SelStart - SelLen)
                End If
            Else
                m_Text = Left$(m_Text, SelStart) & NewText & Right$(m_Text, TextLen - SelStart)
            End If
        Else
            If SelLen Then
                m_Text = NewText & Right$(m_Text, TextLen - SelStart - SelLen)
            Else
                m_Text = NewText & m_Text
            End If
        End If
        m_SelStart = SelStart + Len(NewText)
        m_SelLen = 0
    Else
        m_Text = NewText
        m_SelLen = 0
        m_SelStart = Len(NewText)
    End If
    Set pSite = WindowLessSite
    UpdateCaretPos pSite, CtlRect(pSite), True
    RaiseEvent Change
End Sub

Private Sub UserControl_HitTest(X As Single, Y As Single, HitResult As Integer)
Dim HitResultPassed As VBRUN.HitResultConstants
    HitResultPassed = vbHitResultHit
    RaiseEvent HitTest(X, Y, HitResultPassed)
    HitResult = HitResultPassed
End Sub

Private Sub UserControl_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseDown(Button, Shift, X, Y)
Dim fForceRepaint As Boolean
    If Button = vbLeftButton Then
        m_fHaveMouse = True
        Set m_CachedSite = WindowLessSite
        m_CachedRect = CtlRect(m_CachedSite)
        m_SelStart = SelectionFromPosition(m_CachedSite, m_CachedRect, X)
        fForceRepaint = CBool(m_SelLen)
        m_SelLen = 0
        UpdateCaretPos m_CachedSite, m_CachedRect, fForceRepaint
    End If
End Sub
Private Sub UserControl_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseMove(Button, Shift, X, Y)
Dim iCurPos As Long
Dim NewSelLen As Long
    If m_fHaveMouse Then
        iCurPos = SelectionFromPosition(m_CachedSite, m_CachedRect, X)
        NewSelLen = iCurPos - m_SelStart
        If NewSelLen <> m_SelLen Then
            m_SelLen = NewSelLen
            UpdateCaretPos m_CachedSite, m_CachedRect, True
        End If
    End If
End Sub
Private Sub UserControl_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    RaiseEvent MouseUp(Button, Shift, X, Y)
    If Button = vbLeftButton Then
        Set m_CachedSite = Nothing
        m_fHaveMouse = False
    End If
End Sub

Private Function SelectionFromPosition(pSite As IOleInPlaceSiteWindowless, PosRect As RECT, X As Single) As Integer
Dim Size As Size
Dim hDC As hDC
Dim iChar As Long
Dim hFontOld As Long
Dim pFont As IFont
Dim pString As Long
    If X <= 0 Then
        SelectionFromPosition = 0
    Else
        hDC = pSite.GetDC(PosRect, OLEDC_NODRAW)
        Set pFont = UserControl.Font
        hFontOld = SelectObject(hDC, pFont.hFont)
        If UnicodeSystem Then
            pString = StrPtr(m_Text)
            If m_LeftChar Then
                pString = VBoost.UAdd(pString, 2 * m_LeftChar)
            End If
            GetTextExtentExPointW hDC, pString, Len(m_Text) - m_LeftChar, X, iChar, ByVal 0&, Size
        Else
            If m_LeftChar Then
                GetTextExtentExPointA hDC, Mid$(m_Text, m_LeftChar + 1), Len(m_Text) - m_LeftChar, X, iChar, ByVal 0&, Size
            Else
                GetTextExtentExPointA hDC, m_Text, Len(m_Text), X, iChar, ByVal 0&, Size
            End If
        End If
        SelectObject hDC, hFontOld
        pSite.ReleaseDC hDC
        SelectionFromPosition = iChar + m_LeftChar
    End If
End Function

Private Sub UserControl_Paint()
Dim hDC As Long
Dim pSite As IOleInPlaceSiteWindowless
Dim PosRect As RECT
    If m_fSkipPaint Then Exit Sub

    'If we're transparent, then use the provided hDC
    'Otherwise, get our own for smoother drawing.
    If UserControl.BackStyle = 1 Then
        Set pSite = WindowLessSite
        PosRect = CtlRect(pSite)
        hDC = pSite.GetDC(PosRect, OLEDC_DEFAULT)
        DoPaint hDC, PosRect
        pSite.ReleaseDC hDC
    Else
        PosRect.Right = UserControl.ScaleWidth
        PosRect.Bottom = UserControl.ScaleHeight
        DoPaint UserControl.hDC, PosRect
    End If
End Sub
Private Sub DoPaint(ByVal hDC As Long, PosRect As RECT)
Dim pFont As IFont
Dim hFontStart As Long
Dim TAStart As TAFlags
Dim TextColorStart As Long
Dim BkColorStart As Long
Dim BkModeStart As Long
Dim BkMode As Long
Dim pString As Long
Dim SelStart As Long
Dim SelLen As Long
Dim TextLen As Long

    'See if there's anything to do
    TextLen = Len(m_Text) - m_LeftChar
    If TextLen <= 0 Then Exit Sub
    
    'Clear out caret before painting
    If m_fShowCaret Then HideCaret UserControl.ContainerHwnd
    
    'Get font and background information
    Set pFont = UserControl.Font
    BkMode = BackStyle + 1
    
    'Select objects into the DC
    hFontStart = SelectObject(hDC, pFont.hFont)
    TAStart = SetTextAlign(hDC, TA_LEFT Or TA_UPDATECP)
    TextColorStart = SetTextColor(hDC, AdjustColor(ForeColor))
    BkColorStart = SetBkColor(hDC, AdjustColor(BackColor))
    BkModeStart = SetBkMode(hDC, BkMode)
    MoveToEx hDC, PosRect.Left, PosRect.Top
    
    'Initialize selection information
    NormalizeSelection SelStart, SelLen
    If SelStart < m_LeftChar Then
        If SelStart + SelLen > m_LeftChar Then
            SelLen = SelStart + SelLen - m_LeftChar
            SelStart = 0 'm_LeftChar
        End If
    Else
        SelStart = SelStart - m_LeftChar
        If SelStart = TextLen Then
            SelLen = 0
        Else
            SelLen = SelLen
        End If
    End If
    
    'Get the beginning of the string to draw
    pString = StrPtr(m_Text)
    If m_LeftChar Then
        pString = VBoost.UAdd(pString, 2 * m_LeftChar)
    End If
    
    If SelLen = 0 Then
        'Draw all of the text at once
        ExtTextOutW hDC, 0, 0, ETO_NONE, PosRect, pString, TextLen
    Else
        'Draw portion before the selection
        If SelStart > 0 Then
            ExtTextOutW hDC, 0, 0, ETO_NONE, PosRect, pString, SelStart
            pString = VBoost.UAdd(pString, 2 * SelStart)
        End If
        
        'Draw selection
        SetTextColor hDC, AdjustColor(vbHighlightText)
        SetBkColor hDC, AdjustColor(vbHighlight)
        SetBkMode hDC, APIOPAQUE
        ExtTextOutW hDC, 0, 0, ETO_NONE, PosRect, pString, SelLen
        
        'Draw portion after selection
        If SelStart + SelLen < TextLen Then
            SetTextColor hDC, AdjustColor(ForeColor)
            SetBkColor hDC, AdjustColor(BackColor)
            SetBkMode hDC, BkMode
            pString = VBoost.UAdd(pString, 2 * SelLen)
            ExtTextOutW hDC, 0, 0, ETO_NONE, PosRect, pString, TextLen - SelStart - SelLen
        End If
    End If
    
    'Restore DC settings
    SelectObject hDC, hFontStart
    SetTextAlign hDC, TAStart
    SetBkColor hDC, BkColorStart
    SetBkMode hDC, BkModeStart
    SetTextColor hDC, TextColorStart
    If m_fShowCaret Then ShowCaret UserControl.ContainerHwnd
End Sub
Private Function AdjustColor(ByVal StartColor As Long) As Long
    If StartColor And SysColorBit Then
        AdjustColor = GetSysColor(StartColor And SysColorMask)
    Else
        AdjustColor = StartColor
    End If
End Function
Private Function WindowLessSite() As IOleInPlaceSiteWindowless
Dim pOleObject As IOleObject
    Set pOleObject = Me
    Set WindowLessSite = pOleObject.GetClientSite
End Function
Private Function CtlRect(pSite As IOleInPlaceSiteWindowless) As RECT
Dim pFrame As IOleInPlaceFrame
Dim pDoc As IOleInPlaceUIWindow
Dim ClipRect As RECT
Dim FrameInfo As OLEINPLACEFRAMEINFO
    FrameInfo.cb = Len(FrameInfo)
    pSite.GetWindowContext pFrame, pDoc, CtlRect, ClipRect, FrameInfo
End Function
Private Sub UpdateCaretPos(pSite As IOleInPlaceSiteWindowless, PosRect As RECT, ByVal fForceRepaint As Boolean)
Dim hDC As Long
Dim Size As Size
Dim pFont As IFont
Dim OldFont As Long
Dim pString As Long
Dim CaretPos As Long
Dim TextLen As Long
Dim CaretRect As RECT
Dim hWndContainer As Long
Dim OverFlow As Long
Dim iRightChar As Long
Dim SizeRightChar As Size
Dim fTriedOverflow As Boolean
Dim LeftCharStart As Long
Dim fShowCaret As Boolean
    hWndContainer = UserControl.ContainerHwnd
    LeftCharStart = m_LeftChar
    If m_fShowCaret Then
        HideCaret hWndContainer
        m_fShowCaret = False
    End If
    fShowCaret = True
    pString = StrPtr(m_Text)
    CaretPos = m_SelStart + m_SelLen
    If m_LeftChar Then
        pString = VBoost.UAdd(pString, 2 * m_LeftChar)
        If CaretPos >= m_LeftChar Then
            CaretPos = CaretPos - m_LeftChar
        Else
            'Move 4 at a time
            m_LeftChar = CaretPos - 4
            If m_LeftChar < 0 Then m_LeftChar = 0
            pString = VBoost.UAdd(StrPtr(m_Text), 2 * m_LeftChar)
        End If
    End If
    
    'Get the textwidth from the DC
    hDC = pSite.GetDC(PosRect, OLEDC_NODRAW)
    Set pFont = UserControl.Font
    OldFont = SelectObject(hDC, pFont.hFont)
GetSize:
    If CaretPos = 0 Then
        GetTextExtentPoint32W hDC, pString, 1, Size
        Size.cx = 0
    Else
        GetTextExtentPoint32W hDC, pString, CaretPos, Size
    End If
    If Not fTriedOverflow Then
        OverFlow = Size.cx - (PosRect.Right - PosRect.Left + 1)
        If OverFlow > 0 Then
            If UnicodeSystem Then
                GetTextExtentExPointW hDC, pString, Len(m_Text) - m_LeftChar, PosRect.Right - PosRect.Left, iRightChar, ByVal 0&, SizeRightChar
            Else
                If m_LeftChar Then
                    GetTextExtentExPointA hDC, Mid$(m_Text, m_LeftChar + 1), Len(m_Text) - m_LeftChar, PosRect.Right - PosRect.Left, iRightChar, ByVal 0&, SizeRightChar
                Else
                    GetTextExtentExPointA hDC, m_Text, Len(m_Text) - m_LeftChar, PosRect.Right - PosRect.Left, iRightChar, ByVal 0&, SizeRightChar
                End If
            End If
            m_LeftChar = m_LeftChar + CaretPos - iRightChar + 4
            If m_LeftChar < 0 Then m_LeftChar = 0
            CaretPos = m_SelStart + m_SelLen - m_LeftChar
            If CaretPos < 0 Then CaretPos = 0
            pString = VBoost.UAdd(StrPtr(m_Text), 2 * m_LeftChar)
            fTriedOverflow = True
            GoTo GetSize
        End If
    End If
    SelectObject hDC, OldFont
    pSite.ReleaseDC hDC
    
    'Now, get a DC suitable for painting and paint the control,
    'but only if we're forced or we moved the string.
    If fForceRepaint Or LeftCharStart <> m_LeftChar Then
        m_fSkipPaint = True
        Cls
        m_fSkipPaint = False
        hDC = pSite.GetDC(PosRect, OLEDC_OFFSCREEN)
        DoPaint hDC, PosRect
        pSite.ReleaseDC hDC
    End If
    
    'See if this particular caret position is even visible.
    'It can either be scrolled off, which is unlikely due to
    'the previous checking, or it can be behind another
    'control in the zorder.
    CaretRect.Left = PosRect.Left + Size.cx
    CaretRect.Right = CaretRect.Left + 1
    CaretRect.Top = PosRect.Top
    CaretRect.Bottom = PosRect.Top + Size.cy
    If pSite.AdjustRect(CaretRect) = 1 Then
        'Don't turn on m_fShowCaret
    Else
        IntersectRect CaretRect, CaretRect, PosRect
        CreateCaret hWndContainer, 0, 0, CaretRect.Bottom - CaretRect.Top
        SetCaretPos PosRect.Left + Size.cx, PosRect.Top
        ShowCaret hWndContainer
        m_fShowCaret = True
    End If
End Sub
Private Sub LoseCaret()
    If m_fShowCaret Then
        m_fShowCaret = False
        HideCaret UserControl.ContainerHwnd
    End If
End Sub
Private Sub DisplayCaret()
Dim pSite As IOleInPlaceSiteWindowless
    Set pSite = WindowLessSite
    UpdateCaretPos pSite, CtlRect(pSite), False
End Sub
Private Function DoCopy() As Boolean
Dim strCopyText As String
Dim SelStart As Long
Dim SelLen As Long
    If m_SelLen Then
        NormalizeSelection SelStart, SelLen
        strCopyText = Mid$(m_Text, SelStart + 1, SelLen)
        DoCopy = True
        If Len(strCopyText) Then
            With Clipboard
                .Clear
                .SetText strCopyText
            End With
        End If
    End If
End Function
Private Sub NormalizeSelection(SelStart As Long, SelLen As Long)
    'Normalize selection values.  m_SelLen is negative if
    'the cursor is to the left of the anchor
    If m_SelLen < 0 Then
        SelStart = m_SelStart + m_SelLen
        SelLen = -m_SelLen
    Else
        SelLen = m_SelLen
        SelStart = m_SelStart
    End If
End Sub
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=13,0,0,
Public Property Get Default() As String
Attribute Default.VB_UserMemId = 0
Attribute Default.VB_MemberFlags = "440"
    Default = m_Text
End Property
Public Property Let Default(RHS As String)
    Text = RHS
End Property
'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=13,0,0,0
Public Property Get Text() As String
Attribute Text.VB_UserMemId = -517
    Text = m_Text
End Property
Public Property Let Text(RHS As String)
    m_Text = RHS
    m_LeftChar = 0
    m_SelStart = 0
    m_SelLen = 0
    LoseCaret
    Refresh
    If m_fHaveFocus Then DisplayCaret
    PropertyChanged "Text"
    RaiseEvent Change
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,BackStyle
Public Property Get BackStyle() As LightEditBackStyle
    BackStyle = UserControl.BackStyle
End Property

Public Property Let BackStyle(ByVal New_BackStyle As LightEditBackStyle)
    UserControl.BackStyle() = New_BackStyle
    PropertyChanged "BackStyle"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,BackColor
Public Property Get BackColor() As OLE_COLOR
Attribute BackColor.VB_Description = "Returns/sets the background color used to display text and graphics in an object."
    BackColor = UserControl.BackColor
End Property

Public Property Let BackColor(ByVal New_BackColor As OLE_COLOR)
    UserControl.BackColor() = New_BackColor
    Refresh
    PropertyChanged "BackColor"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,ClipBehavior
Public Property Get ClipBehavior() As LightEditClipBehavior
Attribute ClipBehavior.VB_Description = "Indicates the manner in which a windowless UserControl's appearance is clipped."
    ClipBehavior = UserControl.ClipBehavior
End Property

Public Property Let ClipBehavior(ByVal New_ClipBehavior As LightEditClipBehavior)
    UserControl.ClipBehavior() = New_ClipBehavior
    PropertyChanged "ClipBehavior"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,ForeColor
Public Property Get ForeColor() As OLE_COLOR
Attribute ForeColor.VB_Description = "Returns/sets the foreground color used to display text and graphics in an object."
    ForeColor = UserControl.ForeColor
End Property

Public Property Let ForeColor(ByVal New_ForeColor As OLE_COLOR)
    UserControl.ForeColor() = New_ForeColor
    Refresh
    PropertyChanged "ForeColor"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,FontUnderline
Public Property Get FontUnderline() As Boolean
Attribute FontUnderline.VB_Description = "Returns/sets underline font styles."
Attribute FontUnderline.VB_MemberFlags = "400"
    FontUnderline = UserControl.FontUnderline
End Property

Public Property Let FontUnderline(ByVal New_FontUnderline As Boolean)
    UserControl.FontUnderline() = New_FontUnderline
    PropertyChanged "FontUnderline"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,FontTransparent
Public Property Get FontTransparent() As Boolean
Attribute FontTransparent.VB_Description = "Returns/sets a value that determines whether background text/graphics on a Form, Printer or PictureBox are displayed."
    FontTransparent = UserControl.FontTransparent
End Property

Public Property Let FontTransparent(ByVal New_FontTransparent As Boolean)
    UserControl.FontTransparent() = New_FontTransparent
    PropertyChanged "FontTransparent"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,FontStrikethru
Public Property Get FontStrikethru() As Boolean
Attribute FontStrikethru.VB_Description = "Returns/sets strikethrough font styles."
Attribute FontStrikethru.VB_MemberFlags = "400"
    FontStrikethru = UserControl.FontStrikethru
End Property

Public Property Let FontStrikethru(ByVal New_FontStrikethru As Boolean)
    UserControl.FontStrikethru() = New_FontStrikethru
    PropertyChanged "FontStrikethru"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,FontSize
Public Property Get FontSize() As Single
Attribute FontSize.VB_Description = "Specifies the size (in points) of the font that appears in each row for the given level."
Attribute FontSize.VB_MemberFlags = "400"
    FontSize = UserControl.FontSize
End Property

Public Property Let FontSize(ByVal New_FontSize As Single)
    UserControl.FontSize() = New_FontSize
    PropertyChanged "FontSize"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,FontName
Public Property Get FontName() As String
Attribute FontName.VB_Description = "Specifies the name of the font that appears in each row for the given level."
Attribute FontName.VB_MemberFlags = "400"
    FontName = UserControl.FontName
End Property

Public Property Let FontName(ByVal New_FontName As String)
    UserControl.FontName() = New_FontName
    PropertyChanged "FontName"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,FontItalic
Public Property Get FontItalic() As Boolean
Attribute FontItalic.VB_Description = "Returns/sets italic font styles."
Attribute FontItalic.VB_MemberFlags = "400"
    FontItalic = UserControl.FontItalic
End Property

Public Property Let FontItalic(ByVal New_FontItalic As Boolean)
    UserControl.FontItalic() = New_FontItalic
    PropertyChanged "FontItalic"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,FontBold
Public Property Get FontBold() As Boolean
Attribute FontBold.VB_Description = "Returns/sets bold font styles."
Attribute FontBold.VB_MemberFlags = "400"
    FontBold = UserControl.FontBold
End Property

Public Property Let FontBold(ByVal New_FontBold As Boolean)
    UserControl.FontBold() = New_FontBold
    PropertyChanged "FontBold"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,Font
Public Property Get Font() As Font
Attribute Font.VB_Description = "Returns a Font object."
Attribute Font.VB_UserMemId = -512
    Set Font = UserControl.Font
End Property

Public Property Set Font(ByVal New_Font As Font)
    Set UserControl.Font = New_Font
    Refresh
    PropertyChanged "Font"
End Property

Private Sub UserControl_KeyUp(KeyCode As Integer, Shift As Integer)
    RaiseEvent KeyUp(KeyCode, Shift)
End Sub

Private Sub UserControl_Click()
    RaiseEvent Click
End Sub

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,MousePointer
Public Property Get MousePointer() As VBRUN.MousePointerConstants
Attribute MousePointer.VB_Description = "Returns/sets the type of mouse pointer displayed when over part of an object."
    MousePointer = UserControl.MousePointer
End Property

Public Property Let MousePointer(ByVal New_MousePointer As VBRUN.MousePointerConstants)
    UserControl.MousePointer() = New_MousePointer
    PropertyChanged "MousePointer"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,MouseIcon
Public Property Get MouseIcon() As Picture
Attribute MouseIcon.VB_Description = "Sets a custom mouse icon."
    Set MouseIcon = UserControl.MouseIcon
End Property

Public Property Set MouseIcon(ByVal New_MouseIcon As Picture)
    Set UserControl.MouseIcon = New_MouseIcon
    PropertyChanged "MouseIcon"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,MaskPicture
Public Property Get MaskPicture() As Picture
Attribute MaskPicture.VB_Description = "Returns/sets the picture that specifies the clickable/drawable area of the control when BackStyle is 0 (transparent)."
    Set MaskPicture = UserControl.MaskPicture
End Property

Public Property Set MaskPicture(ByVal New_MaskPicture As Picture)
    Set UserControl.MaskPicture = New_MaskPicture
    PropertyChanged "MaskPicture"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,MaskColor
Public Property Get MaskColor() As OLE_COLOR
Attribute MaskColor.VB_Description = "Returns/sets the color that specifies transparent areas in the MaskPicture."
    MaskColor = UserControl.MaskColor
End Property

Public Property Let MaskColor(ByVal New_MaskColor As OLE_COLOR)
    UserControl.MaskColor() = New_MaskColor
    PropertyChanged "MaskColor"
End Property

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,Refresh
Public Sub Refresh()
Attribute Refresh.VB_Description = "Forces a complete repaint of a object."
    UserControl.Refresh
End Sub

Private Sub UserControl_Resize()
    RaiseEvent Resize
End Sub

'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MappingInfo=UserControl,UserControl,-1,HitBehavior
Public Property Get HitBehavior() As LightEditHitBehavior
Attribute HitBehavior.VB_Description = "Indicates which mode of automatic hit testing a windowless UserControl employs."
    HitBehavior = UserControl.HitBehavior
End Property

Public Property Let HitBehavior(ByVal New_HitBehavior As LightEditHitBehavior)
    UserControl.HitBehavior() = New_HitBehavior
    PropertyChanged "HitBehavior"
End Property

Private Sub InitializeHooks()
Dim HookData As HookData
    If Ambient.UserMode Then
        InitializeIPAOHook m_IPAOHook, Me
        With HookData
            InitializeWindowlessSubclass m_WLSC, Me, nmNotifyAfter, .AggData(0), .IIDs(0), 0
            VBoost.AggregateUnknown Me, .AggData, .IIDs, m_Hook
        End With
    End If
End Sub

'Initialize Properties for User Control
Private Sub UserControl_InitProperties()
    Set UserControl.Font = Ambient.Font
    InitializeHooks
End Sub

'Load property values from storage
Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
    UserControl.BackStyle = PropBag.ReadProperty("BackStyle", 1)
    UserControl.BackColor = PropBag.ReadProperty("BackColor", &H80000005)
    UserControl.ClipBehavior = PropBag.ReadProperty("ClipBehavior", 0)
    UserControl.ForeColor = PropBag.ReadProperty("ForeColor", &H80000012)
    Set UserControl.Font = PropBag.ReadProperty("Font", Ambient.Font)
    UserControl.MousePointer = PropBag.ReadProperty("MousePointer", 3)
    Set UserControl.MouseIcon = PropBag.ReadProperty("MouseIcon", Nothing)
    Set UserControl.MaskPicture = PropBag.ReadProperty("MaskPicture", Nothing)
    UserControl.MaskColor = PropBag.ReadProperty("MaskColor", &H8000000F)
    m_Text = PropBag.ReadProperty("Text", vbNullString)
    UserControl.HitBehavior = PropBag.ReadProperty("HitBehavior", 0)
    InitializeHooks
End Sub

'Write property values to storage
Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
    Call PropBag.WriteProperty("BackStyle", UserControl.BackStyle, 1)
    Call PropBag.WriteProperty("BackColor", UserControl.BackColor, &H80000005)
    Call PropBag.WriteProperty("ClipBehavior", UserControl.ClipBehavior, 0)
    Call PropBag.WriteProperty("ForeColor", UserControl.ForeColor, &H80000012)
    Call PropBag.WriteProperty("Font", UserControl.Font, Ambient.Font)
    Call PropBag.WriteProperty("MousePointer", UserControl.MousePointer, 3)
    Call PropBag.WriteProperty("MouseIcon", MouseIcon, Nothing)
    Call PropBag.WriteProperty("MaskPicture", MaskPicture, Nothing)
    Call PropBag.WriteProperty("MaskColor", UserControl.MaskColor, &H8000000F)
    Call PropBag.WriteProperty("Text", m_Text, vbNullString)
    Call PropBag.WriteProperty("HitBehavior", UserControl.HitBehavior, 0)
End Sub

